home *** CD-ROM | disk | FTP | other *** search
/ CD Exchange / CD Exchange - Volume 1.iso / graphics / utils / iconian / shovecolors.e < prev    next >
Text File  |  1994-02-26  |  4KB  |  189 lines

  1. MODULE 'exec/memory',
  2.              'intuition/intuition','intuition/screens','intuition/gadgetclass',
  3.              'intuition/screens',
  4.              'graphics/rastport','graphics/gfx','graphics/text',
  5.              'graphics/view',
  6.              'libraries/iffparse','iffparse',
  7.              'dos/dos','dos/dosextens','dos/dosasl','exec/tasks'
  8.  
  9.     OBJECT bitmapheader
  10.         w:INT;h:INT;x:INT;y:INT
  11.         depth:CHAR;masking:CHAR
  12.         compression:CHAR;pad1:CHAR;transparentcolor:INT
  13.         xaspect:CHAR;yaspect:CHAR;pagewidth:INT;pageheight:INT
  14.     ENDOBJECT
  15.     DEF source[250]:STRING
  16.     DEF argarray[11]:LIST
  17.     DEF    iff=NIL:PTR TO iffhandle
  18.     DEF cn=NIL:PTR TO contextnode
  19.     DEF    ierror,rlen
  20.     DEF    des=NIL:PTR TO rastport
  21.     DEF bmhd=NIL:PTR TO bitmapheader
  22.     DEF sp=NIL:PTR TO storedproperty
  23.     DEF planedata[10]:LIST
  24.     DEF widthbytes,pokeplane,body,origbody,numbytes
  25.     DEF ditz,dang,dumb,dope
  26.     DEF destrgb[260]:LIST
  27.     DEF vp=NIL:PTR TO viewport
  28.     DEF cm,clipx,clipy
  29.     DEF depth,iffdepth,nc,nci,scratch
  30.     DEF rdarg
  31.     DEF viewport=NIL:PTR TO viewport
  32.     DEF scr=NIL:PTR TO screen
  33.     DEF bitmap=NIL:PTR TO bitmap
  34.     DEF quiet=FALSE
  35.     DEF lock[260]:LIST
  36.  
  37. PROC main() HANDLE
  38.     IF KickVersion(39)=NIL
  39.         WriteF('\nGet OS3.x (maybe a nice A1200?)\n')
  40.         CleanUp(21)
  41.     ENDIF
  42.  
  43.     iffparsebase:=OpenLibrary('iffparse.library',39)
  44.  
  45.     rdarg:=ReadArgs('FILE/A,QUIET=Q/S',argarray,0)
  46.     IF rdarg>0
  47.         IF argarray[0]<>NIL
  48.             StrCopy(source,argarray[0],ALL)
  49.         ENDIF
  50.         IF argarray[1]<>NIL
  51.             quiet:=TRUE
  52.         ENDIF
  53.         FreeArgs(rdarg)
  54.     ELSE
  55.         Raise(1)
  56.     ENDIF
  57.     IF (scr := LockPubScreen(NIL)) = NIL
  58.         Raise(1)
  59.     ELSE
  60.         bitmap:=scr.bitmap
  61.         viewport:=scr.viewport
  62.         depth:=bitmap.depth
  63.         cm:=viewport.colormap
  64.     ENDIF
  65.  
  66.     iff:=AllocIFF()
  67.     
  68.     iff.stream:=Open(source,MODE_OLDFILE)
  69.     IF (iff.stream)
  70.         InitIFFasDOS(iff)
  71.     ELSE
  72.         Raise(1)
  73.     ENDIF
  74.  
  75.     ierror:=OpenIFF(iff,IFFF_READ)
  76.     ierror:=PropChunk(iff,"ILBM","LOCK")
  77.     ierror:=PropChunk(iff,"ILBM","CMAP")
  78.     ierror:=StopOnExit(iff,"ILBM","FORM")
  79.     ierror:=ParseIFF(iff,IFFPARSE_SCAN)
  80.  
  81.     IF(sp:=FindProp(iff,"ILBM","LOCK"))
  82.         body:=sp.data
  83.         FOR scratch:=0 TO (sp.size-1)
  84.             ditz:=Char(body++)
  85.             lockpen(scratch,ditz)
  86.         ENDFOR
  87.     ENDIF
  88.     IF(sp:=FindProp(iff,"ILBM","CMAP"))
  89.         body:=sp.data
  90.         FOR scratch:=0 TO (sp.size/3)-1
  91.             ditz:=Char(body++)
  92.             dang:=Char(body++)
  93.             dumb:=Char(body++)
  94.             IF (scratch<(Shl(1,depth)))
  95.                 IF lock[scratch]=FALSE
  96.                     setrgb32(viewport,scratch,ditz,dang,dumb)
  97.                 ENDIF
  98.             ENDIF
  99.         ENDFOR
  100.     ELSE
  101.         Raise(1)
  102.     ENDIF
  103.     Raise(0)
  104. EXCEPT
  105.     IF scr THEN UnlockPubScreen(0,scr)
  106.     IF (iff)
  107.         CloseIFF(iff)
  108.         IF (iff.stream) THEN Close(iff.stream)
  109.         FreeIFF(iff)
  110.     ENDIF
  111.     IF iffparsebase THEN CloseLibrary(iffparsebase)
  112.     IF ((exception) AND (quiet=FALSE)) THEN WriteF('ShoveColors Failed.\n')
  113. ENDPROC
  114.  
  115. PROC getrgb32(cm,fc,nc,tab)
  116.     DEF ret
  117.     MOVE.L cm,A0
  118.     MOVE.L fc,D0
  119.     MOVE.L nc,D1
  120.     MOVE.L tab,A1
  121.     MOVE.L gfxbase,A6
  122.     JSR    -$384(A6)
  123.     MOVE.L D0,ret
  124. ENDPROC ret
  125.  
  126. PROC setrgb32(vp,pen,red,green,blue)
  127.     MOVE.L vp,A0
  128.   MOVE.L pen,D0
  129.   MOVE.L red,D1
  130.   SWAP   D1
  131.   LSL.L  #8,D1
  132.   MOVE.L green,D2
  133.   SWAP   D2
  134.   LSL.L  #8,D2
  135.   MOVE.L blue,D3
  136.   SWAP   D3
  137.   LSL.L  #8,D3
  138.   MOVE.L gfxbase,A6
  139.   JSR    -$354(A6)
  140. ENDPROC
  141.  
  142. PROC obtainpen(cm,n,r,g,b,f)
  143.     DEF ret
  144.     MOVE.L gfxbase,A6
  145.     MOVE.L n,D0
  146.   MOVE.L r,D1
  147.   SWAP   D1
  148.   LSL.L  #8,D1
  149.   MOVE.L g,D2
  150.   SWAP   D2
  151.   LSL.L  #8,D2
  152.   MOVE.L b,D3
  153.   SWAP   D3
  154.   LSL.L  #8,D3
  155.     MOVE.L cm,A0
  156.     MOVE.L f,D4
  157.     JSR    -$3BA(A6)
  158.     MOVE.L D0,ret
  159. ENDPROC ret
  160.  
  161. PROC releasepen(cm,n)
  162.     MOVE.L cm,A0
  163.     MOVE.L n,D0
  164.     MOVE.L gfxbase,A6
  165.     JSR    -$3B4(A6)
  166. ENDPROC
  167.  
  168. PROC lockpen(pn,mode)
  169.  
  170.     DEF cmtable,red,green,blue,dummy
  171.  
  172.     cmtable:=[0,0,0,0,0,0]:LONG
  173.     getrgb32(cm,pn,1,cmtable)
  174.     red:=Char(cmtable)
  175.     green:=Char(cmtable+4)
  176.     blue:=Char(cmtable+8)
  177.  
  178.     dummy:=obtainpen(cm,pn,red,green,blue,0)
  179.  
  180.     IF dummy<0
  181.         lock[pn]:=TRUE /* Pen was unavailable, so DON'T release/change! */
  182.     ELSE
  183.         IF (mode=0) /* Was able to lock, but it needs to be *free* */
  184.             releasepen(cm,pn)
  185.         ENDIF
  186.         lock[pn]:=FALSE
  187.     ENDIF
  188. ENDPROC
  189.